#================================================
package Net::MySpaceIM;
#================================================

=head1 MySpaceIM v1.0

=cut

use strict;
use warnings;
use LWP::UserAgent;
use Data::Dumper;

# Socket Modules
use IO::Select;
use IO::Socket::INET;

# Modules for the Challenge
use MIME::Base64;
use Digest::SHA1  qw(sha1);
use Crypt::RC4;

# coloring for console for debug options
use Term::ANSIColor;
$Term::ANSIColor::AUTORESET = 1;
require Win32::Console::ANSI if($^O eq "MSWin32");

# service module handles all the messages form the myspace server
use Net::MySpaceIM::Services;

sub new{
	my $class = shift;

	my $self  = {
	         Host          => 'im.myspace.akadns.net',
	         Port          => 1863,
	         username        => '',
	         password      => '',
	         Debug         => 0,
	         ShowTX        => 0,
	         ShowRX        => 0,
	         TXRXDump      => 0,
	         AutoReconnect => 1,
	         Select        => new IO::Select(),
	         Connections   => {},
	         Connected     => 0,
	         @_
	};
	bless( $self, $class );
	return $self;
}

=item
connect

Connect to MySpaceIM. Call this after your object is created and your event handlers are set.

=cut

sub connect{
	my $self = shift;

	$self->{socket} = new IO::Socket::INET->new(
	               PeerAddr => $self->{Host},
	               PeerPort => $self->{Port},
	               Proto => 'tcp') or die "Couldn't connect!";

	$self->{Select}->add($self->{socket});

	# if success set a varrible fo uptime stats
	#$self->{Connected} = time;
}


=item
do_one_loop()

Process a single cycle's worth of incoming and outgoing messages.  This should be done at a regular intervals, preferably under a second.

=cut

sub do_one_loop{
	my $self = shift;
	my $data;
	# return immediately if we are not connected
	#return if( !$self->{Connected} );

	select ( undef, undef, undef ,.1); #sleep for .1 second to prevent CPU spikes
	my @ready = $self->{Select}->can_read(.1);
	foreach my $fh (@ready){
	    my $pack;
	    #read the packet
	    sysread( $fh, $pack, 2048, length( $pack || '' ) );

	    return unless($pack);

	    print colored($pack, 'red'), "\n" if($self->{ShowRX});
	    # each packet ends in \final\ if there is room they are pushed together
	    foreach my $item (split(/\\final\\/, $pack)) {

            $item =~ s/\/1/\//g;
            $item =~ s/\/2/\\/g;

            my $packet;
	        my ($data, $cmd) = $item =~ /^(\\(\w+)\\(.*?))$/;
	        while ($data =~ m/\\([^\\]+)\\([^\\]+)/g)
	        {
	             $packet->{$1} = $2;
	        }
	        if($Net::MySpaceIM::Services::MySpaceIM_serivces->{$cmd})
	        {
	               my $function = $Net::MySpaceIM::Services::MySpaceIM_serivces->{$cmd}->{action};
	               &$function($self, $packet) if($function);
	        }
	        print colored(Dumper($packet), 'red'), "\n" if($self->{TXRXDump});
	    }
	}
}

sub run{
	my $self = shift;
	while(1){
	         $self->do_one_loop();
	}
}

sub send_pack{
	my $self = shift;
	my $pack = shift;
	$self->{socket}->print($pack);
	print colored("$pack", 'green'), "\n" if($self->{ShowTX});
}

sub send_message{
	my $self = shift;
    my $to = shift;
    my $message = shift;

    $self->send_pack("\\bm\\1\\sesskey\\".$self->{info}->{sesskey}."\\t\\$to\\cv\\716\\msg\\<p><f f='Arial' h='11'><c v='black'><b v='rgba(255, 255, 255, 0)'>$message</1b></1c></1f></1p>\\final\\");
}

=item
setHandler($event, $handler)

$event should be an event listed in the events section.  These are called based on information sent by MySpace,
receiving a message is an event, status changes are events, getting a call is an event, etc.

	$myspaceim->setHandler( Connected => \&connected );

	sub connected {
	         my $self = shift;
	         print "Yay we connected";
	}

=cut

sub setHandler{
	my $self = shift;
	my ($event, $handler) = @_;
	$self->{handler}->{$event} = $handler;
}

sub setHandlers{
	my $self = shift;
	my $handlers = { @_ };
	for my $event (keys %$handlers){
		$self->setHandler( $event, $handlers->{$event} );
	}
}

sub call_event{
	my $self = shift;
	my $receiver = shift;
	my $event = shift;

         # get and run the handler if it is defined
	my $function = $self->{handler}->{$event};
	return &$function( $receiver, @_ ) if( defined $function );
	# get and run the default handler if it is defined
	$function = $self->{handler}->{Default};
	return &$function( $receiver, $event, @_ ) if( defined $function );

         return undef;
}

#checksum
sub checksum {
 	my $o = tell(DATA);
	seek DATA,0,0;
	local $/;
	my $t = unpack("%32C*",<DATA>) % 65535;
	seek DATA,$o,0;
	my $str = do{local $/; <DATA>};
	return $t;
};

#challenge
sub challenge{
	my ($self, $username, $password, $nc) = @_;
	$nc = decode_base64($nc);

	# Convert ASCII password to UTF16 little endian.
	$password =~ s/(.)/$1\0/g;

	my $hash = sha1(sha1($password) . substr($nc, 32));

	# Win32 CryptoAPI's CryptDeriveKey takes first 0x10 bytes to make key
	my $cipher = Crypt::RC4->new(substr($hash, 0,0x10));
	my $ret = $cipher->RC4(
	    substr($nc, 0,32) .
	    $username .
	    # this should be some ip data..?
	    "\0\0\0\0\x05\x7f\0\0\x01\0\0\0\0\x0a\0\0\x40".
	    "\xc0\xa8\x58\x01\xc0\xa8\x3c\x01"
	);

	# base64 has some weird line break.. remove that
	($ret = encode_base64($ret)) =~ s/\n//g;
	return $ret;
}

=head1 AUTHOR

Matt Austin E<lt>matt@m-austin.comE<gt>.

=head1 CREDITS

Code based on Jeff Connelly and libpurple.

=head1 LEGAL

Copyright (c) 2007 Matt Austin.  All rights reserved.
This program is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut

1;
__DATA__